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MODULE FORSFIND ( ! Implements FORTRAN FIND scesenent 
SENT = '2=-016' ' File: FORFIND.B32 Edit: JBS2016 


BEGIN 


RRR A AAA AAA AEAAAREAeAAAAAAAKAA KAAS 


is COPYRIGHT (c) 1978, 1980, 1982, 1984 8 
it DIGITAL EQUIPMENT CORPORATION, MAYNARD. MASSACHUSETTS. 
ie ALL RIGHTS RESERVED. 

it THIS SOFTWARE 1S FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 


i 

® 

® 

® 

® 

® 

® 

® 

; N ION OF T 0 C S N H * 
'w COPIES THEREOF MAY WOT BE PROV DED OO OTHERWISE MADE AVAILABLE TO ANY * 
; ER THE SOFTWARE IS HEREBY * 
'® TRANSFERRED. e 
® 

® 

® 

* 

® 

*® 

® 

® 

*® 

* 


'® THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
te CORPORAT IO NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
:* . 


'* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
'® SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


lee 

' FACILITY: FORTRAN Support Library - User Callable 

i ABSTRACT: | 
This module implements the FORTRAN FIND statement. 

This is performed by doing poh bei a READ Direct 
1/0 statement would do, except actually doing the I/0. 
i ENVIRONMENT: User access mode; mixture of AST level or not. 
i AUTHOR: Jonathan M. Taylor, CREATION DATE: 1-OCT-77 : Version 0 | 
i MODIFIED BY: | 


i] 
' 
' 
' 
' 
! 
' 
! 
' 
' 
' 
i 
‘ 
' 
' 
! JNT. 24-OCT-77: VERSION 2 
' 
' 
' 
' 
' 
i] 
1 
i] 
' 
' 
' 


-0 ori 
-1 - e-FO FORSK_abcmnoxyz as EXTERNAL LITERALS. TNH 27-Oct-77 
“ - Chan tet to oles EFREQ; INVRECNUM to RECNUMOUT, TNH 29-Oct-77 
- - Use . 

-5 = Global ce ister CCB. JMT 8-Apr-78 

“06 - change, ® EQUIRE ites for on system build. DGP 28-Apr-78 

-07 = Use JSB grr es. TNH 


Pass OPENSK.LUN MIN to Fonstle PUSH, TNH 22-May-78 
Chan enge file name to FORFIND.B and, ch hangs. the. names of 
the REQUIRE thee plat loriy. 
Y date he cop ht notice. JBS cna 78 
-011 = Change the RE UiR file names from FOR... to OTS... JBS 07-DEC-78 
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FORSF IND 16-Sep-1984 t 98: 2:43 VAX-11 Bliss-32 V4.0-742 Page 2 
2-016 le-Sep-1 984 1 1:58 CFO BRRTLeS ation! IND.832;1 (1) 
; 0058 1! 2-012 - Spenee oo back to wae and change the oprgttx on 
; FF 0059 1! m pare eneters from OPEN to LUB. S$ 13-DEC-78 

; 6&0 0060 1 ! 2-013 - add LIBRARY RILSTARLE so thet Ue RoPN” A use its symbols. 

; 6) 0061 1! JBS 10-APR-19 

3 6¢ Bne8 1 ! 2-014 = Actual!y do a $F #45) here. ee IOSTAT handler. SBL 8-May-1979 

ae 0063 1 ! 2-015 = Set LUASV FIND. L AST. se 1 May-1979 

; 64 0064 1 ! 2-016 = Put BUILTIN ACTUAL COUN n the routine since the next version of 

s 65 0065 1! the BLISs nfomeraer will require it to be there. Since we are 

; © Bes 1! edit tng th is module, improve the source, ggxt layout. Note that 

3 67 067 1! this edit changes no code. JBS 21-Aug-1 

; 0068 1 !-- 

:; 8669 94 1 

; 70 070 1 !<BLF/PAGE> 
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FORSF IND bese =1984 00:22:4 AX-11 Bliss-32 V4.0-742 Page 3 FOF 
2-016 1e-8ep-19 4 90:99:83 FORRTL.SRCIFORF IND .B325 1 ° (2) | 2-( 
: i 071 1! | : 
3 7 ore 1 ' SWITCHES: ; 
Paes Bae fea: 
H 8 OR ee } SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); ‘ 
; 78 OOr7 | | ; 
3 79 Boe 1 ! LINKAGES: ‘ 
; 80 079 1! | ; 
; 81 0080 1 | ; 
; ag 0081 1 REQUIRE ‘RTLIN:OTSLNK'; ! define all Linkages ; 
; 8 8219 1 | ° 
3 84 1 ‘ 
; 85 b21¢ 1 ! TABLE OF CONTENTS: : 
> 86 0513 1! | ; 
6 «667 0514 1 ; 
; «88 0515 1 FORWARD ROUTINE : 
; 89 0516 1 FORSF IND; ! FORTRAN FIND statement | : 
> 90 0517 1 | ; 
3 WH 0518 1! | 
; 9 0519 1 ! INCLUDE FILES: : 
; Y 0520 1} | ; 
3 94 0521 1 : 
; 4 Be ; i LIBRARY 'RTLSTARLE'; ! System symbols : 
3 44 0394 ! REQUIRE ‘RTLML:FORERR'; ' FORTRAN error number definitions ; 
; 190 0395 ! REQUIRE ‘RTLML:FORPAR’; ! Inter-module constants | : 
: 101 O81? | REQUIRE 'RTLIN:FOROPN'; ! FORTRAN OPEN/CLOSE parameters | : 
: 108 534 ! REQUIRE ‘RTLIN:RTLPSECT'; ! Define DECLARE_PSECTS macro ‘ 
s 105 0977 1 REQUIRE ‘RTLML:OTSLUB'; ' Get LUB offsets 3 
; 106 1117 «1 3 
s 107 1118 1! $ 
; 108 1119 1 =! MACROS: : 
: 109 1120 1! ; 
: 110 1121 1! NONE 3 
; 06111 1156 1! 3 
3 \N¢ 18 1 ! EQUATED SYMBOLS: $ 
ae 1124 1! ; 
; 6116 1125 1! NONE | 8 
> 115 1186 1 i | : 
s 116 11 1 ! OWN STORAGE: ; 
: 117 1128 1! 3 
: 118 1129 1! NONE | 3 
> 119 1130 1 | | : 
: 120 1131 1 =! EXTERNAL REFERENCES: é 
> 121 11 : 1} | ; 
3 \$¢ 11 1 ; 
. he 1134 1 EXTERNAL ROUTINE 3 
: 126 1135 1 FORSSIOSTAT_HND, ' Error handler 
: 125 11 § 1 FORSSOPEN_DEFLT : CALL_CCB NOVALUE, ' FORTRAN default file opener 
; 16 11 1 FORSSSIGNAL_STO : NOVACUE ' convert error code and signal 
+ 127 1138 1 FORS$$ASSOC : CALL_CCB NOVALUE, i store rec. # in assoc. variable 
; 128 1139 1 FORS$SCB_PUSH : JSB_CB_PUSH NOVALUE, ! Get a control block 
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!' Return a control block 


: JSB_CB_POP NOVALUE; 
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PSECT DECLARATIONS: 
DECLARE _PSECTS (FOR); 


! Declare PSECTS for FORS$ facility 
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a@ parameter. 
ass. var. Users associated variable gets new LOG_RECNO 
LUB$V_F IND_LAST Set to 1 after successful 


ROUTINE VALUE: 
NONE 


ind, else 0. 


COMPLETION CODES: 
NONE 
SIDE EFFECTS: 


1? GLOBAL ROUTINE FORSFIND (UNIT, REC_NO, ERR_EQL) = 

14 14+ 

: ' FUNCTIONAL DESCRIPTION: 

1 Call CB_PUSH to get a control block for this UNIT. 

1 If has not been declared to be direct access then ERROR. 

1 If not already open then open ad direct-access, OLD, unformatted. 
1 Set the record number into the LUB and (optionally) into the 

15 users associated variable. 

12 Call RMS to SFIND and lock the record. Return the 1/0 system to its previous state. 
15 FORMAL PARAMETERS: 

16 UNIT. rlu.v Unit number (call by value) 

16 REC_NO.rl.v Record number to seek (call by value) 
16 ERR_EQL.rl.v If 1, return IOSTAT value 

ss If omitted or zero, signal all errors 
1 IMPLICIT INPUTS: 

16 LUBSV_DIRECT 1 if DEFINE FILE done or OPEN with access="DIRECT' 
18 LUB$V_OPENED 1 if file previously opened 

A IMPLICIT OUTPUTS: 

i LUB$L_LOG_RECNO Gets set to the record number passed as 
17 

17 

17 

17 

17 

18 

18 

18 

18 

18 

18 

18 

18 
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The file is positioned to the requested record and the record is locked. 

1 Users associated variable (if Age takes the value o 

1 the new record number. The file is seenes if it was never opened before. 
SIGNAL_STOPs FORS$_OPEDEFREQ ( g = "OPEN OR DEFINE FILE REQUIRED FOR DIRECT ACCESS’) 
$I —STOPs FORS_RECNUMOUT (25 = ‘RECORD NUMBER OUT OF RANGE’ 
SIGNAL_STOPS FORS_ATTACCNON (36 = ‘ATTEMPT TO ACCESS NON-EXISTANT RECORD") 
SIGNAL_STOPs FOR$_SPERECLOC (36 = "SPECIFIED RECORD LOCKED’) 
SIGNAL_STOPs FORS_FINERR (57 = ‘FIND ERROR’) 


BEGIN 


GLOBAL REGISTER 
CCB = K_CCB_REG : REF BLOCK C, BYTE); 


BUILTIN 
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uur 


ACTUAL COUNT; 


CAL 
L_UNWIND ACTION : VOLATILE, 
L-ERR_EQC_PRES : VOLATILE, 
STATUS; 


ENABLE 
FORSSIOSTAT_HND (L_UNWIND ACTION, L_ERR_EQL_PRES); 


4 
Set up unwind action and flag if ERR= or IOSTAT was present. 


L_UNWIND_ACTION = FORSK_UNWINDNOP; 
IF (ACTUALCOUNT () GTR 2) THEN L_ERR_EQL_PRES = .ERR_EQL ELSE L_ERR_EQL_PRES = 0; 


COOGCOCCOCOCOCOOOONOOO 


SCOONAUS UN (OO ONAMUE WN (OVO ONAUES WN “OO ONAUE WN "OOONOUS 


| 
| 
‘ | 
' Get a LUB for this unit. 
On return, CCB points to the current control block. 
FORS$SCB_PUSH (.UNIT, LUBSK_LUN_MIN); | 
| Error action is now to pop the LUB. | 
LLUNWIND_ACTION = FORSK_UNWINDPOP; 
. | 
: If file not specified for direct access, then SIGNAL STOP FORS$_OPEDEFREQ 
(26 = "DIRECT ACCESS NOT SPECIFIED WHEN UNIT OPENED’) 
a 
| 
| 


IF (.CCB CLUBSV_DIRECT] EQL 0) THEN FORSSSIGNAL_STO (FORSK_OPEDEFREQ); 
1+ 
If file has not been previously OPENed, default-open it. 


WAR RIPUNOPYANINONONNY 2 SS OS OO 


IF (.CCB CLUBSV_OPENED] EQL 0) THEN FORSSOPEN_DEFLT (OPENSK_ACC_DIR, OPENSK_TYP_OLD, OPENSK_FOR_UNF); 


14 
! If the logical record number passed is illegal then SIGNAL_STOP, 
else store in the LUB and users associated variable. 
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4 nts Je EQLU 0) OR ((.CCB CLUBSL_REC_MAX] NEQ 0) AND (.REC_NO GTRU .CCB CLUBSL_REC_MAX]))) | 

FORSSSIGNAL_STO (FORSK_RECNUMOUT); 
CCB CLUBSL_LOG_RECNO] = .REC_NO; 
i Now FIND the record. If any error, signal it. 


WAWWAAWA 
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, at 
NO 


'¢ 
: Set LUBSV_FIND_tAST to zero. If successful, we will set to 1. 
"CCB CLUBSV_FIND_LAST) = 0; 
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.CCB)) 
FORSK_SPERECLOC; 


CRMS$_RLK] : 
CRMS$_RNF, RMS$_EOF] : 


CB CRABSL_STS] EQL RMS$_RSA) DO 
SET 


FORSSSIGNAL_STO ( 
SELECTONEU .CCB CRABSL 


( NOT SFIND (RAB = 


THEN 


BEGIN 


IF 


6 ATTACCNON; 


F 
COTHERWISE) : 


TH OPNT NOR. DOOM MUM TN OR- DAO CUM TFTMOR.. DAKO CUM TMOR. DOOKUMTNO 
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DAAAAAAAAAD DD OO OOO PORRRRARENER www 


RSK. 
FORSK_F INERR; 


TES); 


Set LUBSV_FIND_LAST. 


CCB CLUBSV_FIND_LAST) = 1; 
Store the associated variable 


END; 


FORSSCB_POP (); 
Return a success IOSTAT code 


FORSSASSOC (); 
Return the 1/0 system to its last state. 
RETURN 0; 


We succeeded. 
END; 
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K 9 | 
FORSF IND 16-Sep-1984 00:22:4 AX-11 Bliss-32 V4.0-742 Page 9) 
2-016 10238b-1 $82 99:99:88 FORRTL.SRCIFORFIND.B3251 - (3) | 
4 12 900BD BNEQ 118 | 
4 DD OOOBF 108:  PUSHL #36 ; | ; 
§ 11 C BRB eS ; : 
DD C3 11$: PUSHL # ; 138% ‘ 
63 1 fe C 163: CALL #1, EGS SMA 570 3 1275 ‘ 
AQ AB 8 C8 15$: BISB #8, -96(CCB) : 1293 ; 
000000006 00 FB cf CALLS #0, FORSSASSOC : 193! ; 
000000006 16 000D JSB FORSSCB_POP : 1301 : 
D4 00009 CLRL OR : 1305 ; 
Se 0DB RET : 1306 ‘ 
0000 Q00DC 14$ . WORD sexs nothing ; 1198 : 
50 08 AC” D0 0000 ov. = -BCAP), RO : ; 
0 4 A 3 E MOVL 4(RO), R : | e 
F8 AQ OF itd PUSHAB L_ERR_EQL_PRES ; ‘ 
FC AQ 9F QOOE PUSHAB L-UNWIND_ACTION ; : 
Q2 pd OO0EC PUSHL #2 : ; 
E 0D tit PUSHL SP ; e 
7E 04 A 7D QOOF MOVQ 4 (AP), =(SP) ; F 
000000006 00 03 FB QO0F4 CALLS #3, FORSSIOSTAT_HND : ; 
04 000FB RET : ; 
; Routine Size: 252 bytes, Routine Base: _FORSCODE + 0000 3 
; 297 1307 1 ; 
; 298 1308 1 END ! of module FORSFIND ; 
; ev? 1309 1 : 
: 300 1310 0 ELUDOM | ; 
; PSECT SUMMARY ; 
; Name Bytes Attributes : 
;  FORSCODE 252 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 3 
: Library Statistics ; 
ene a a oe tee Symbols -------- Pages Processing : 
; File Total Loaded Percent Mapped Time : 
; _$255$DUA28:(SYSLIBISTARLET.L32;1 9776 1 0 581 00:01.0 | : 


: COMMAND QUALIFIERS 


1$oseoctgRe OO:g2:45  yanedt OLtegc sz, v4.0-742_ 


; BLISS/CHECK=(FIELD, INITIAL OPTIMIZE) /NOTRACE/LIS=LIS$:FORF IND/OBJ=OBJ$:FORFIND MSRC$:FORF IND/UPDATE=(ENH$:F ORF IND) 


IND 


3; Size: 252 fode ¢ + 0 data bytes 
3; Run Time: 

; Elapsed Time: bs 9. 3 

3 Lines/CPU Min: 8 § 

; Ronenee/SAE-Aie: 321 

3 cme | Used: 142 pages 

; Compilation Complete 
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